home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 6 / 64er_Magazin_Sonderheft_06_86-06_1986_Markt__Technik_de_Disk_2_of_3_Side_A.d64 / listing 2 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  19KB  |  624 lines
  1. 5 rem  **********************************
  2. 10 rem *   giga-cad     graphic-system  *
  3. 15 rem *         'cad.main'             *
  4. 20 rem * by s. vilsmeier & s. lippstreu *
  5. 25 rem **********************************
  6. 30 :
  7. 35 :
  8. 40 a=peek(836)+1:poke836,a:ifa=1thenpoke55,0:poke56,80:clr:a=1
  9. 45 ifa=1thenload"hires4.cad.obj",8,1
  10. 50 ifa=2thenload"hires6.cad.obj",8,1
  11. 55 sys50707,1:poke53280,14:dimb$(63):ifd=0thengosub3060:poke808,237
  12. 60 close1:open1,8,15,"u9":close1:sys37021
  13. 65 :
  14. 70 :
  15. 75 rem **********************************
  16. 80 rem *   variablen / sys-adresssen    *
  17. 85 rem **********************************
  18. 90 :
  19. 95 n=50181:co=50292:e=50707:g=50859:li=51049:jo=51627:h2=1
  20. 100 re=51800:t2=52490:mu=52517:cp=36878:j2=39247:d1=40052:c2=40206
  21. 105 l4=21764:um=22873:ml=21839
  22. 110 fr=51480:uf=51507:f(1)=11:f(2)=12:f(3)=0:f(4)=15
  23. 115 ifpeek(53263)=1andl=1thenb=1:ri=0:gosub2475:sysco,2,0:poke53263,0:goto125
  24. 120 syse,1:sysn,11,15,2:ri=0:l=1:ifd<>1thenb=2:gosub2875
  25. 125 sysg,160,190,319,199,0,2:syst2,2:ifd=1thensys25919:v=0:k=0
  26. 130 syscp,2:sysre,0,0,319,199,1,2:sysco,1,0
  27. 135 poke192,0:close1:open1,8,15,"xr+":print#1,"u9":close1:goto525
  28. 140 :
  29. 145 :
  30. 150 rem *********************************
  31. 155 rem *   manipulationen bei filmen   *
  32. 160 rem *********************************
  33. 165 :
  34. 170 ifa=1anddr<>0thendr=0:goto420
  35. 175 ifa=3anddl<>0thendl=0:goto420
  36. 180 ifa=2anddu<>0thendu=0:goto420
  37. 185 input"[147][196]rehung um [216],[217], oder [218]-[193]chse";a$:c=asc(a$)-87
  38. 190 ifa=1thendr=c:du=0:goto410
  39. 195 ifa=3thendl=c:goto410
  40. 200 ifa=2thendu=c:dr=0:goto410
  41. 205 print"[147][211]ummanden des [198]luchtpunktes  5,15,5";
  42. 210 input"";kx,ky,kz:goto410
  43. 215 print"[147][214]erschiebungsfaktor     5.5"
  44. 220 input"[145]";kf::kf=-kf:goto410
  45. 225 print"[147][206]eigung der [218]-[193]chse    -30"
  46. 230 input"[145]";zv::goto410
  47. 235 print"[147][214]ergroesserungsfaktor   3"
  48. 240 input"[145]";vf:vf=vf*100:goto410
  49. 245 gosub1015:ifa$<>"j"goto410
  50. 250 a=49153:pokea+940,dr:pokea+941,dl:w=kx:i=942:gosub2815
  51. 255 w=ky:gosub2815:w=kz:gosub2815
  52. 260 w=vf:gosub2815
  53. 265 w=kf:gosub2815:l=.5:pokea+952,du:goto2400
  54. 270 dr=0:dl=0:kx=0:ky=0:kz=0:vf=0:kf=0:goto420
  55. 275 :
  56. 280 :
  57. 285 rem *********************************
  58. 290 rem *   menue:  zusaetze            *
  59. 295 rem *********************************
  60. 300 :
  61. 305 gosub615:print"               [218]usaetze                "
  62. 310 gosub620
  63. 315 print"[193]. 4-fache [193]ufloesung"
  64. 320 print"[194]. 10-fache [193]ufloesung"
  65. 325 print"[195]. [198]ilm erstellen"
  66. 330 print"[196]. [198]ilm ergaenzen"
  67. 335 print"[197]. [210]ahmen zeichen an ";:ifrn=0thenprint"[157][157][157]aus"
  68. 340 gosub1020
  69. 345 gosub635:ifa$="_"thensyse,1:goto525
  70. 350 ifa<1ora>5goto345
  71. 355 onagoto360,370,410,480,490
  72. 360 gosub1015:ifa$<>"j"goto305
  73. 365 l=2:ri=0:wm=0:bs=0:mc=0:goto2395
  74. 370 gosub1015:ifa$<>"j"goto305
  75. 375 l=2:ri=1:wm=0:bs=0:mc=0:goto2395
  76. 380 :
  77. 385 :
  78. 390 rem *********************************
  79. 395 rem *     menue:  film              *
  80. 400 rem *********************************
  81. 405 :
  82. 410 gosub615:print"            [198]ilm erstellen             "
  83. 415 gosub620
  84. 420 print"[193]. [196]rehung des [203]oerpers an ";:ifdr=0thenprint"[157][157][157]aus";
  85. 425 print:print"[194]. [196]rehung um den [203]oerper an ";:ifdu=0thenprint"[157][157][157]aus";
  86. 430 print:print"[195]. [196]rehung der [204]ichtquelle an ";:ifdl=0thenprint"[157][157][157]aus";
  87. 435 print:print"[196]. [214]erschieben des [198]luchtpunktes"
  88. 440 print"[197]. [214]erschieben der [211]chnittebene"
  89. 445 print"[198]. [203]ippen der [218]-[193]chse"
  90. 450 print"[199]. [193]endern der [199]roesse"
  91. 455 print"[200]. [194]erechnung"
  92. 460 print"[201]. [206]eue [208]arameter"
  93. 465 gosub635:ifa$="_"goto305
  94. 470 ifa<1ora>9goto345
  95. 475 onagoto170,170,170,205,215,225,235,245,270
  96. 480 gosub1015:ifa$<>"j"goto305
  97. 485 l=3:ri=0:wm=0:goto2395
  98. 490 rn=1-rn:goto315
  99. 495 :
  100. 500 :
  101. 505 rem *********************************
  102. 510 rem *  joystick-abfrage hauptmenue  *
  103. 515 rem *********************************
  104. 520 :
  105. 525 o=160:p=10:poke53280,14:ds=0:fi=0
  106. 530 gosub1030:ifpeek(631)<>0goto530
  107. 535 ifp>9goto530
  108. 540 ifo<57goto2970
  109. 545 ifo>97ando<126goto1760
  110. 550 ifo>288goto1105
  111. 555 ifo>126ando<165goto1360
  112. 560 ifd=1goto530
  113. 565 ifo>57ando<97goto2230
  114. 570 ifo>165ando<233goto2395
  115. 575 ifo>234ando<287goto305
  116. 580 :
  117. 585 :
  118. 590 rem *********************************
  119. 595 rem *     diverse unterprogramme    *
  120. 600 rem *********************************
  121. 605 :
  122. 610 goto530
  123. 615 print"[147][151] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]":return
  124. 620 fori=1to22:print" [165]                                    [167]":next
  125. 625 print"[160][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]":return
  126. 630 syse,0:printchr$(14)chr$(8)"[151]";:return
  127. 635 geta$:ifa$=""goto635
  128. 640 a=asc(a$)-64:return
  129. 645 sysl4,0,0,0,199,1,1:sysl4,319,0,319,199,1,2:iffi=1thensysl4,0,0,319,0,1,3
  130. 650 return
  131. 655 :
  132. 660 :
  133. 665 rem *********************************
  134. 670 rem *        disk - status          *
  135. 675 rem *********************************
  136. 680 :
  137. 685 close1
  138. 690 open1,8,15:input#1,f,f$,t,s:iff=0thenreturn
  139. 695 gosub1020:print:print"[196]iskettenfehler :"
  140. 700 print""f","f$","t","s:ifds=0andfithenreturn
  141. 705 close2:print#1,"u9":close1:ifds=0thengosub635:return
  142. 710 print"[206]och ein [214]ersuch  (j/n) ?"
  143. 715 gosub635:ifa$="n"thenf=99:print"[147]":return
  144. 720 ifa$="j"thenf=1:print"[147]":return
  145. 725 goto715
  146. 730 :
  147. 735 :
  148. 740 rem *********************************
  149. 745 rem *    rahmen-blinken bei 'zoom'  *
  150. 750 rem *********************************
  151. 755 :
  152. 760 sysl4,r,q,o-1,q,2,1:sysl4,o,q,o,p-1,2,1
  153. 765 sysl4,o,p,r+1,p,2,1:sysl4,r,p,r,q+1,2,1:pm=1-pm:return
  154. 770 w=w+1:ifj1<>jthenw=1
  155. 775 ifw>20thenw=20
  156. 780 j1=j:p=p+w*(j=1)-w/m*(j=3)-w*(j=5)+w/m*(j=7)
  157. 785 o=o+w*m*(j=1)-w*(j=3)-w*m*(j=5)+w*(j=7):return
  158. 790 :
  159. 795 :
  160. 800 rem *********************************
  161. 805 rem *      angewaehltes symbol      *
  162. 810 rem *********************************
  163. 815 :
  164. 820 ifo<50thenr=3:rx=49:q1=1:goto835
  165. 825 ifo<100thenr=50:rx=99:q1=3:goto835
  166. 830 r=100:rx=156:q1=2
  167. 835 ifp<135thenq=102:ry=134:q2=2:goto850
  168. 840 ifp<165thenq=135:ry=164:q2=1:goto850
  169. 845 q=165:ry=196:q2=0
  170. 850 c=q2*3+q1:return
  171. 855 sysg,r,q,rx,ry,2,b:return
  172. 860 :
  173. 865 :
  174. 870 rem *********************************
  175. 875 rem *    verformung per joystick    *
  176. 880 rem *********************************
  177. 885 :
  178. 890 ifbq=1andei=0thenbq=0:b=2:gosub855
  179. 895 sysjo:j=peek(859)
  180. 900 ifj=0goto895
  181. 905 ifj=128goto920
  182. 910 ifint(j/2)=j/2goto895
  183. 915 j=int(j/2)+1:return
  184. 920 b=2:gosub855:c=0:bq=1:return
  185. 925 :
  186. 930 :
  187. 935 rem *********************************
  188. 940 rem *   verformung ueber tastatur   *
  189. 945 rem *********************************
  190. 950 :
  191. 955 ifa<49ora>57thenc=0:return
  192. 960 a=a-48:xa=int((9-a)/3)*3:xb=a-int((a-1)/3)*3
  193. 965 xb=3+(xb<2)*2+(xb>2)*1:c=xa+xb:ei=1:gosub630:geta$
  194. 970 ifc>6theninput"[147][196]rehwinkel   90[157][157][157][157]";w:return
  195. 975 ifc>3theninput"[147][214]erschiebungssummand   50[157][157][157][157]";w:return
  196. 980 input"[147][214]erzerrrungsfaktor   1.5[157][157][157][157][157]";w:return
  197. 985 :
  198. 990 :
  199. 995 rem  ********************************
  200. 1000 rem *   diverse unterprogramme ii. *
  201. 1005 rem ********************************
  202. 1010 :
  203. 1015 print" [211]ind [211]ie sicher ? [146]":gosub635:return
  204. 1020 ifpeek(53272)<>23thengosub630
  205. 1025 return
  206. 1030 sysj2,o,p,0:o=peek(2024)+256*peek(2025):p=peek(2026):return
  207. 1035 close1
  208. 1040 open2,8,2,n1$+left$(n$,10)+str$(fi*2+(b-2))+",p,w":gosub690:iff=0goto1055
  209. 1045 iff=99thenclose2:gosub3115:return
  210. 1050 close1:close2:open1,8,15,"s:"+n1$+left$(n$,10)+str$(fi*2+(b-2)):goto1035
  211. 1055 sys26068,b:close2:gosub3115:return
  212. 1060 ei=1:gosub630:geta$:input"[147][214]erzerrungsfaktor   1.5[157][157][157][157][157]";w
  213. 1065 sysre,2,101,157,197,0,1:sysum,1,0,1,d,1,0,w:sysum,2,0,1,d,1,0,w:return
  214. 1070 syse,0:goto2970:rem 'darstellen'
  215. 1075 :
  216. 1080 :
  217. 1085 rem ********************************
  218. 1090 rem *   darstellungs - 'modi'      *
  219. 1095 rem ********************************
  220. 1100 :
  221. 1105 yu=0:gosub615:print"          [196]arstellungs - [205]odi          "
  222. 1110 gosub620
  223. 1115 print"[193]. [198]luchtpunktdarstellung an ";:iffl=0thenprint"[157][157][157]aus";
  224. 1120 print:print"[194]. [218]eichnen der [211]chnittlinien an ";
  225. 1125 ifsl=0thenprint"[157][157][157]aus";
  226. 1130 print:print"[195]. [200]idden-[204]ine [205]odus an ";:ifhd=0thenprint"[157][157][157]aus";
  227. 1135 print:print"[196]. [211]chattierungs-[205]odus an ";:ifwq=0thenprint"[157][157][157]aus";
  228. 1140 print:print"[197]. [204]ichtquellen-[203]oordinaten"
  229. 1145 print"[198]. [205]ulticolour-[205]odus an ";:ifmc=0thenprint"[157][157][157]aus";
  230. 1150 print:print"[199]. [196]oppelmodus [200]ires & [205]ulti an ";
  231. 1155 ifwm=0thenprint"[157][157][157]aus";
  232. 1160 print:print"[200]. [200]idden-[204]. & [211]chattierung an ";:ifbs=0thenprint"[157][157][157]aus";
  233. 1165 print:print"[201]. [211]chnittebene an ";:ifse=0thenprint"[157][157][157]aus";
  234. 1170 gosub1020
  235. 1175 gosub635:ifa$="_"thensyse,1:goto525
  236. 1180 ifa<1ora>9goto1175
  237. 1185 onagoto1195,1190,1215,1220,1225,1245,1250,1265,1255
  238. 1190 sl=1-sl:goto1115
  239. 1195 fl=1-fl:iffl=0goto1280
  240. 1200 print"[147][198]luchtpunkt-[203]oordinaten:"
  241. 1205 print"[216],[217],[218]   "str$(a1)","str$(a2)","str$(a3):yu=1
  242. 1210 input"[145]";a1,a2,a3:goto1280
  243. 1215 hd=1-hd:goto1305
  244. 1220 wq=1-wq:goto1310
  245. 1225 print"[147][203]oordinaten der [204]ichtquelle:"
  246. 1230 print"[216],[217],[218]   "wx"[157],"wy"[157],"wz
  247. 1235 input"[145]";wx,wy,wz:ifwx=0andwy=0andwz=0goto1235
  248. 1240 goto1105
  249. 1245 mc=1-mc:goto1280
  250. 1250 wm=1-wm:goto1290
  251. 1255 se=1-se:ifsegoto1270
  252. 1260 goto1280
  253. 1265 bs=1-bs:goto1295
  254. 1270 yu=1:print"[147][212]iefe der [211]chnittebene:"
  255. 1275 print"[217]   "str$(-ke):input"[145]";ke:ke=-ke:goto1280
  256. 1280 :
  257. 1285 ifmcthenwm=0:bs=0
  258. 1290 ifwmthenmc=0:bs=0
  259. 1295 ifbsthenmc=0:wm=0
  260. 1300 ifseormcorwmorbsthenwq=1:hd=1
  261. 1305 ifhd=0thenwq=0
  262. 1310 ifwq=0thenmc=0:wm=0:se=0:bs=0
  263. 1315 ifwqthenhd=1
  264. 1320 ifyugoto1105
  265. 1325 goto1115
  266. 1330 :
  267. 1335 :
  268. 1340 rem ********************************
  269. 1345 rem *    menue 'zoom'              *
  270. 1350 rem ********************************
  271. 1355 :
  272. 1360 sysg,127,0,165,9,2,1
  273. 1365 gosub615:print"             [218]oom - [205]enue              "
  274. 1370 gosub620
  275. 1375 print"[193]. [218]oomen des [207]bjekts"
  276. 1380 print"[194]. [207]rginalgroesse"
  277. 1385 print"[195]. [207]ptimaler [193]usschnitt"
  278. 1390 print"[196]. [194]etrachten der [199]rafik"
  279. 1395 print"[197]. [218]entrieren":gosub1020
  280. 1400 gosub635:ifa$="_"thensyse,1:sysg,127,0,165,9,2,1:goto525
  281. 1405 if(a<1ora>5)or(a<>4andd=1)goto1400
  282. 1410 onagoto1445,1550,1585,1640,1675
  283. 1415 :
  284. 1420 :
  285. 1425 rem ********************************
  286. 1430 rem *   'zoomen des objekts'       *
  287. 1435 rem ********************************
  288. 1440 :
  289. 1445 syse,1:o=160:p=100:m=8/5:pm=0
  290. 1450 gosub1030
  291. 1455 if(peek(631))=95goto1545
  292. 1460 sysjo:ifpeek(859)=128goto1460
  293. 1465 r=o:q=p
  294. 1470 gosub760:sysjo:j=peek(859):geta$:ifa$<>""goto1525
  295. 1475 ifj=0orj>128thenw=0:goto1470
  296. 1480 ifpmthengosub760
  297. 1485 ifj=128goto1505
  298. 1490 ifint(j/2)=j/2goto1470
  299. 1495 ifo<rtheno=r:p=q:w=0
  300. 1500 gosub770:goto1470
  301. 1505 ifr=ogoto1545
  302. 1510 h=320/(abs(r-o))*h:f1=r/h2+f1:f2=q/h2+f2:h2=h:ifpm=0thengosub760
  303. 1515 sysn,11,15,2:b=2:gosub2875:sysre,0,0,319,199,1,2
  304. 1520 sysg,160,190,318,198,0,2:syscp,2:syst2,2:sysco,1,0:goto525
  305. 1525 ifpmthengosub760
  306. 1530 ifa$="_"goto1545
  307. 1535 ifa$="l"goto1445
  308. 1540 goto1470
  309. 1545 sysg,127,0,165,9,2,1:goto525
  310. 1550 syse,1:f1=0:f2=0:h=1:h2=1:goto1515:rem 'orginalgroesse'
  311. 1555 :
  312. 1560 :
  313. 1565 rem ********************************
  314. 1570 rem *   'optimaler ausschnitt'     *
  315. 1575 rem ********************************
  316. 1580 :
  317. 1585 pm=0:ifh<>1thenpm=1
  318. 1590 syse,1:o=-8000:p=o:r=-o:q=-o:f1=0:f2=0:h=1:h2=1
  319. 1595 i=0:fora=1tov:sysd1,a:y1=usr(1):u=usr(2):z1=usr(3):gosub2910
  320. 1600 ifu>otheno=u
  321. 1605 ifz1>pthenp=z1
  322. 1610 ifu<rthenr=u
  323. 1615 ifz1<qthenq=z1
  324. 1620 nexta:r=r-1:q=q-1:o=o+1:p=p+1:m=8/5
  325. 1625 b1=abs(o-r):b2=abs(p-q)
  326. 1630 ifb1<b2*mthenfa=b2*m:o=o+abs(fa-b1)/2:r=r-abs(fa-b1)/2:goto1510
  327. 1635 ifb1>b2/mthenfa=b1/m:p=p+abs(fa-b2)/2:q=q-abs(fa-b2)/2:goto1510
  328. 1640 sysg,127,0,165,9,2,1:syse,2:b=2:goto2130:rem 'betrachten der grafik'
  329. 1645 :
  330. 1650 :
  331. 1655 rem ********************************
  332. 1660 rem *    'zentrieren'              *
  333. 1665 rem ********************************
  334. 1670 :
  335. 1675 syse,1:o=-8000:p=o:r=-o:q=r:qz=r:pz=p:f1=0:f2=0:h=1:h2=1
  336. 1680 i=0:fora=1tov:sysd1,a:u=usr(1):y1=usr(2):z1=usr(3)
  337. 1685 ifu>otheno=u
  338. 1690 ify1>pthenp=y1
  339. 1695 ifz1>pzthenpz=z1
  340. 1700 ifu<rthenr=u
  341. 1705 ify1<qthenq=y1
  342. 1710 ifz1<qzthenqz=z1
  343. 1715 nexta:fx=(r+o)/2:fy=(q+p)/2:fz=(qz+pz)/2
  344. 1720 sysum,4,0,0,d,1,0,fx:sysum,5,0,0,d,1,0,-fy:sysum,6,0,0,d,1,0,fz
  345. 1725 sysn,11,15,2:syse,1:goto115
  346. 1730 :
  347. 1735 :
  348. 1740 rem ********************************
  349. 1745 rem *       disk - menue           *
  350. 1750 rem ********************************
  351. 1755 :
  352. 1760 gosub615:print"              [196]isk - [205]enue             "
  353. 1765 gosub620
  354. 1770 print"[193]. [207]bjekt laden"
  355. 1775 print"[194]. [207]bjekt speichern"
  356. 1780 print"[195]. [196]iskettenkommando senden"
  357. 1785 print"[196]. [196]irectory anzeigen"
  358. 1790 print"[197]. [199]rafik laden"
  359. 1795 print"[198]. [199]rafik speichern"
  360. 1800 gosub1020
  361. 1805 gosub635:ifa$="_"thensyse,1:goto525
  362. 1810 ifa<1ora>6goto1805
  363. 1815 onagoto1850,1925,2060,2000,2110,2165
  364. 1820 :
  365. 1825 :
  366. 1830 rem ********************************
  367. 1835 rem *      'objekt laden'          *
  368. 1840 rem ********************************
  369. 1845 :
  370. 1850 gosub615:gosub625:print"              [207]bjekt laden             [146]"
  371. 1855 input"[207]bjekt - [206]ame    ";n$:ifn$="_"orn$=""goto1760
  372. 1860 open2,8,2,"ob."+n$+",s,r":gosub685:iff<>0goto1760
  373. 1865 h=1:l=1:f1=0:f2=0:fk=0:h2=1:v=0:d=1:k=0:sys25919
  374. 1870 input#2,d:input#2,v:input#2,k
  375. 1875 sys22541,d,v
  376. 1880 fori=1tok:input#2,b$(i):next
  377. 1885 sysc2,v+1,d,0,0
  378. 1890 close2:gosub685:gosub3115:syse,1:sysn,11,15,2:goto115
  379. 1895 :
  380. 1900 :
  381. 1905 rem ********************************
  382. 1910 rem *      'objekt speichern'      *
  383. 1915 rem ********************************
  384. 1920 :
  385. 1925 ifd=1goto1805
  386. 1930 gosub615:gosub625::print"            [207]bjekt speichern           [146]"
  387. 1935 input"[207]bjekt - [206]ame    ";n$:ifn$="_"orn$=""goto1760
  388. 1940 open2,8,2,"ob."+n$+",s,w":gosub685:iff<>0goto1760
  389. 1945 print#2,d:print#2,v:print#2,k
  390. 1950 sys22520,d,v
  391. 1955 fori=1tok:print#2,b$(i):next
  392. 1960 close2:gosub685:gosub3115
  393. 1965 goto1760
  394. 1970 :
  395. 1975 :
  396. 1980 rem ********************************
  397. 1985 rem *   'directory anzeigen'       *
  398. 1990 rem ********************************
  399. 1995 :
  400. 2000 print"[147]";:gosub615:print"           [196]irectory anzeigen          [146]"
  401. 2005 print:open2,8,0,"$0":sys26134:close2
  402. 2010 :close2
  403. 2015 close1:open1,8,15:input#1,f,f$,t,s:iff=0goto2025
  404. 2020 print"":gosub695:goto1760
  405. 2025 print#1,"u9":close1:gosub635:goto1760
  406. 2030 :
  407. 2035 :
  408. 2040 rem ********************************
  409. 2045 rem *  'diskettenkommando senden'  *
  410. 2050 rem ********************************
  411. 2055 :
  412. 2060 gosub615:gosub625:print"       [196]iskettenkommando senden        [146]"
  413. 2065 poke631,34:poke198,1:n$="":input"[203]ommando ";n$:ifn$="_"goto1760
  414. 2070 close1:open1,8,15,n$:input#1,f,f$,t,s:print" [196]iskettenstatus: "
  415. 2075 gosub700:goto1760
  416. 2080 :
  417. 2085 :
  418. 2090 rem ********************************
  419. 2095 rem *   'grafik laden'             *
  420. 2100 rem ********************************
  421. 2105 :
  422. 2110 gosub615:gosub625:print"              [199]rafik laden             [146]"
  423. 2115 input"[199]rafik - [206]ame    ";n$:ifn$="_"orn$=""goto1760
  424. 2120 print"[147]":open2,8,2,"pi."+n$+",p,r":gosub685:iff<>0goto1760
  425. 2125 sysn,11,15,2:syse,2:sys26101,2:close2:print#1,"u9":close1:b=2
  426. 2130 gosub2475:syse,1:goto525
  427. 2135 :
  428. 2140 :
  429. 2145 rem ********************************
  430. 2150 rem *    'grafik speichern'        *
  431. 2155 rem ********************************
  432. 2160 :
  433. 2165 gosub615:gosub625:print"            [199]rafik speichern           [146]"
  434. 2170 cr=a:input"[199]rafik - [206]ame    ";n$:ifn$="_"orn$=""goto2190
  435. 2175 ifcr=6theninput"[199]rafik - [194]ildschirm # ";b
  436. 2180 open2,8,2,"pi."+n$+",p,w"
  437. 2185 sys26068,b:close2:gosub685:close1:open1,8,15:print#1,"u9":close1
  438. 2190 ifcr=6thensyse,1:goto525
  439. 2195 return
  440. 2200 :
  441. 2205 :
  442. 2210 rem ********************************
  443. 2215 rem *      'form'                  *
  444. 2220 rem ********************************
  445. 2225 :
  446. 2230 sysco,2,0:sysg,58,0,96,9,2,2:sysg,0,100,158,104,0,2:bq=1
  447. 2235 sysmu,2:sysre,0,99,159,199,1,2:sysre,2,101,157,197,1,2:syse,2:b=2
  448. 2240 o=160:p=100:jl=0
  449. 2245 gosub1030
  450. 2250 ifpeek(631)<>0thena=peek(631):goto2325
  451. 2255 ifo>57ando<97andp<9thena=95:goto2325
  452. 2260 ifo>159orp<100goto2245
  453. 2265 gosub820:ifc=0goto2245
  454. 2270 gosub890:ifc=0goto2245
  455. 2275 sysre,2,101,157,197,0,2:sysum,c,0,0,d,ei,j,w
  456. 2280 ifjl>0thenjl=jl+1:sysre,2,101,157,197,1,2:ifei=0goto2270
  457. 2285 ifjl>0thenei=0:bq=1:c=0:goto2245
  458. 2290 b=1:dh=hd:hd=0:sysn,11,15,1:gosub2875:hd=dh
  459. 2295 sysre,0,0,319,199,1,1:syst2,1:sysg,160,190,318,198,0,1:syscp,1
  460. 2300 syse,1:sysco,2,0:sysg,0,100,158,104,0,2:sysg,58,0,96,9,2,2
  461. 2305 sysmu,2:sysre,0,99,159,199,1,2:sysre,2,101,157,197,1,2
  462. 2310 ifjlthenjl=1:syse,2:poke53280,14:goto2325
  463. 2315 ifeithenei=0:bq=1:c=0:syse,2:goto2245
  464. 2320 b=2:gosub855:bq=0:syse,2:goto2270
  465. 2325 ifa=95andjl>1thenpoke53280,14:goto2290
  466. 2330 ifa=95thensyse,1:goto525
  467. 2335 ifa=133andjl=0thenjl=1:poke53280,6:goto2245
  468. 2340 ifa=133andjl=1thenjl=0:poke53280,14:goto2245
  469. 2345 ifa=133andjl>1thenpoke53280,14:goto2290
  470. 2350 ifa=48thengosub1060:c=3:syse,2:goto2275
  471. 2355 gosub955:ifc=0orw=0thensyse,2:ei=0:w=0:c=0:bq=1:goto2245
  472. 2360 syse,2:goto2275
  473. 2365 :
  474. 2370 :
  475. 2375 rem ********************************
  476. 2380 rem *      'darstellen'            *
  477. 2385 rem ********************************
  478. 2390 :
  479. 2395 sysn,11,15,2:syse,2:poke53280,15
  480. 2400 ifhdthenprint"[147]";:syse,0:goto2975
  481. 2405 ifl<>1thengosub630:input"[147][198]ile - [206]ame ";n$
  482. 2410 ifl<>1thends=1:syse,1:print"[147]":open1,8,15,"xr-":print#1,"u9":poke192,192
  483. 2415 ifl=.5goto2565
  484. 2420 ifl=2andri=1goto2700
  485. 2425 ifl=2goto2725
  486. 2430 ifl=3goto2750
  487. 2435 b=2:gosub2875
  488. 2440 gosub2475:sysco,1,0:syse,1:goto125
  489. 2445 :
  490. 2450 :
  491. 2455 rem ********************************
  492. 2460 rem *      grafik betrachten       *
  493. 2465 rem ********************************
  494. 2470 :
  495. 2475 xa=1:poke53280,15
  496. 2480 gosub635:a=a+64:ifa>48anda<51thenb=a-48:syse,b
  497. 2485 ifa<133ora>140goto2500
  498. 2490 a=a-132:i=a-int(a/5)*4:w=-(a<5)+(a>4):f(i)=f(i)+w:iff(i)<0thenf(i)=15
  499. 2495 iff(i)>15thenf(i)=0
  500. 2500 ifa=83thena=0:gosub630:gosub2165
  501. 2505 ifa=82thensysre,0,0,319,199,1,3
  502. 2510 ifa=95thensysml,11,15,0,1:sysml,11,15,0,2:poke53281,15:syse,b:return
  503. 2515 ifa=77thenxa=1-xa
  504. 2520 sysml,f(1),f(2),f(3),b:poke53280,f(4):poke53281,f(4)
  505. 2525 ifxathensysml,f(1),f(4),0,b:syse,b
  506. 2530 goto2480
  507. 2535 :
  508. 2540 :
  509. 2545 rem ********************************
  510. 2550 rem * darstellung in allen groessen*
  511. 2555 rem ********************************
  512. 2560 :
  513. 2565 sysn,11,15,2:syse,2:poke53280,15
  514. 2570 close1:open1,8,15,"s:cad.main.datas":print#1,"xr-":print#1,"u9":poke192,192
  515. 2575 close1:open2,8,2,"cad.main.datas,s,w":gosub685:iff=0goto2590
  516. 2580 iff=99thenclose2:gosub3115:syse,1:goto135
  517. 2585 close2:close1:goto2570
  518. 2590 sys22520,d,v:close2:gosub3115:f3=f1:f4=f2:dv=du:vx=a1:vy=a2:vz=a3
  519. 2595 h2=h:forfi=1to24:b=2:syse,2:h3=(vf-100)/100/24*fi+1:ifdu=0thendu=dr
  520. 2600 sysre,310,0,319,194,1,2:sys50859,311,1,318,fi*8+1,1,2
  521. 2605 ifdu=1thensysum,8,0,1,d,1,0,15*fi
  522. 2610 ifdu=2thensysum,7,0,1,d,1,0,15*fi
  523. 2615 ifdu=3thensysum,9,0,1,d,1,0,15*fi
  524. 2620 a1=a1+kx:a2=a2+ky:a3=a3+kz:du=dv:ifzvthensysum,8,0,1,d,1,0,zv
  525. 2625 ifvf<>0thenh=h2*h3:f2=f4-(100/h3-100)/h2:f1=f3-(160/h3-160)/h2
  526. 2630 gosub2875:syse,0:ifrnthensysre,0,0,159,95,1,2
  527. 2635 open2,8,2,"fi."+n$+str$(fi)+",p,w":gosub685:iff=0goto2650
  528. 2640 iff=99thenclose2:gosub3115:goto2655
  529. 2645 close2:close1:open1,8,15,"s:fi."+n$+str$(fi):goto2635
  530. 2650 sys22299:close2
  531. 2655 ds=0:close1:open2,8,2,"cad.main.datas,s,r":gosub690:iff=0goto2685
  532. 2660 print" [196]iskette mit [211]ystemdaten einlegen !"
  533. 2665 print" [206]och einen [214]ersuch (j/n) ?"
  534. 2670 gosub635:ifa$="j"thenclose2:print"[147]":goto2655
  535. 2675 ifa$="n"thenclose2:sys25919:df=1:vi=0:mn=0:sysn,11,15,2:syse,1:goto125
  536. 2680 goto2670
  537. 2685 sys22541,d,v:close2:gosub3115:ds=1
  538. 2690 sysn,11,15,2:next:f1=f3:f2=f4
  539. 2695 h=h2:a1=vx:a2=vy:a3=vz:syse,1:l=1:poke192,0:poke53280,14:goto135
  540. 2700 print"[147]":forfi=1to5:sysn,11,15,1:sysn,11,15,2:syse,1:sysfr,0:b=1
  541. 2705 fk=fi*200-200:gosub2875:sysuf,1:syse,0:ifrnthengosub645
  542. 2710 ifrnandfi=5thensysl4,0,199,319,199,1,3
  543. 2715 n1$="hz.":b=1:gosub1035:b=2:gosub1035
  544. 2720 gosub3115:nextfi:fk=0:l=1:ri=0:goto120
  545. 2725 forfi=1to2:b=1:sysn,11,15,1:sysn,11,15,2:syse,1:sysfr,0
  546. 2730 fk=(fi-1)*200:gosub2875:sysuf,1:syse,0:ifrnthengosub645
  547. 2735 ifrnandfi=2thensysl4,0,199,319,199,1,3
  548. 2740 n1$="hv.":b=1:gosub1035:b=2:gosub1035
  549. 2745 gosub3115:nextfi:fk=0:l=1:ri=0:goto120
  550. 2750 sysn,11,15,2:syse,2:l=.5:gosub2875:l=1:ifrnthensysre,0,0,159,95,1,2
  551. 2755 open2,8,2,"fi."+n$+",p,w":gosub685:iff=0goto2770
  552. 2760 iff=99goto2775
  553. 2765 close2:close1:open1,8,15,"s:fi."+n$:close1:goto2755
  554. 2770 sys22299
  555. 2775 close2:gosub3115:syse,1:l=1:goto135
  556. 2780 :
  557. 2785 :
  558. 2790 rem ********************************
  559. 2795 rem *     parameter-uebergabe      *
  560. 2800 rem ********************************
  561. 2805 :
  562. 2810 w2=int(w/256):w1=w-256*w2:pokea+i,w1:pokea+i+1,w2:i=i+2:return
  563. 2815 ifabs(w)>3276.7thenw=3276.7*sgn(w)
  564. 2820 w=w*10+32768:gosub2810:return
  565. 2825 poke53280,15:gosub630:print"[147]        [211]ystemdiskette einlegen !"
  566. 2830 gosub635:ifa$="_"thenreturn
  567. 2835 open2,8,2,n$+",p,r":close2:gosub685:iffthena$="_":return
  568. 2840 print#1,"u9":close1:return
  569. 2845 forx=1tok:fory=1to13:w=peek(a+y):ifw=254theny=13:goto2855
  570. 2850 b$(x)=b$(x)+chr$(w)
  571. 2855 nexty:a=a+14:nextx:a=49153:return
  572. 2860 forx=1tok:fory=1tolen(b$(x)):pokea+y,asc(mid$(b$(x),y,1)):nexty
  573. 2865 pokea+y,254:a=a+14:nextx:a=49153:return
  574. 2870 w1=a+i:w=((peek(w1)+256*peek(w1+1))-32768)/10:i=i+2:return
  575. 2875 sys20480,d,fl,ri,a1,a2,a3,h,l,f1,f2,fk,b:return:rem darstellen
  576. 2880 :
  577. 2885 :
  578. 2890 rem ********************************
  579. 2895 rem *        extrema               *
  580. 2900 rem ********************************
  581. 2905 :
  582. 2910 iffl=0then2930
  583. 2915 ify1-a2=0thent=0:goto2925
  584. 2920 t=y1/(y1-a2)
  585. 2925 u=u-t*(u-a1):z1=z1-t*(z1-a3)
  586. 2930 ifri=1thenx4=u:u=-z1*1.5:z1=x4*1.5
  587. 2935 u=((u+160)-f1)*h*l:z1=((z1+100)-f2)*h*l-fk*h:return
  588. 2940 :
  589. 2945 :
  590. 2950 rem ********************************
  591. 2955 rem *    parameter codieren        *
  592. 2960 rem ********************************
  593. 2965 :
  594. 2970 n$="cad.create":goto2980
  595. 2975 n$="cad.paint"
  596. 2980 gosub2825:ifa$="_"thensyse,1:poke53280,14:goto525
  597. 2985 a=49153:w=fl+2*wq+4*mc+8*ri+16*se+32*wm+64*bs+128*hd:pokea+912,w
  598. 2990 i=900:w=k:gosub2810:w=d:gosub2810:w=v:gosub2810
  599. 2995 w=a1:gosub2815:w=a2:gosub2815:w=a3:gosub2815:i=i+1:w=wx:gosub2815
  600. 3000 w=wy:gosub2815:w=wz:gosub2815:i=i+2:w=f1:gosub2815:w=f2:gosub2815
  601. 3005 w=ke:gosub2815:pokea+919,l*2:pokea+954,sl:i=898:w=zv:gosub2815
  602. 3010 pokea+920,rn:w$=str$(h):pokea+927,len(w$)
  603. 3015 forw=1tolen(w$):pokea+927+w,asc(mid$(w$,w,1)):nextw:ifkthengosub2860
  604. 3020 poke836,0:print"[155][147]load"chr$(34)n$chr$(34)",8"
  605. 3025 print"run:":poke631,19:poke632,13:poke633,13:poke198,3:new
  606. 3030 :
  607. 3035 :
  608. 3040 rem ********************************
  609. 3045 rem *    parameter decodieren      *
  610. 3050 rem ********************************
  611. 3055 :
  612. 3060 a=49153:k=peek(a+900):d=peek(a+902)+256*peek(a+903)
  613. 3065 v=peek(a+904)+256*peek(a+905)
  614. 3070 ifpeek(a+919)=255thenwy=500:wz=-200:a1=50:a2=300:a3=30:l=1:h=1:goto3110
  615. 3075 i=906:gosub2870:a1=w:gosub2870:a2=w
  616. 3080 gosub2870:a3=w:i=i+1:gosub2870:wx=w:gosub2870:wy=w:gosub2870:wz=w
  617. 3085 i=i+2:gosub2870:f1=w:gosub2870:f2=w:gosub2870:ke=w:l=peek(a+919)/2
  618. 3090 w=peek(a+912):rn=peek(a+920)
  619. 3095 fl=wand1:wq=(wand2)/2:mc=(wand4)/4:ri=(wand8)/8:se=(wand16)/16
  620. 3100 wm=(wand32)/32:bs=(wand64)/64:hd=(wand128)/128:sl=peek(a+954)
  621. 3105 n$="":forx=1topeek(a+927):n$=n$+chr$(peek(a+927+x)):nextx:h=val(n$)
  622. 3110 gosub2845:return
  623. 3115 close1:open1,8,15,"u9":close1:return
  624.